home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Libraries / SAT 2.3.8 / Demos / Zkrolly demo ƒ / Zkrolly.p < prev    next >
Text File  |  1996-06-29  |  3KB  |  102 lines
  1. program Zkrolly;
  2.     uses
  3. {$ifc UNDEFINED THINK_PASCAL}
  4.         Types, QuickDraw, Fonts, Windows, Dialogs, OSUtils, Memory, {}
  5.         Events,
  6. {$endc}
  7.         SAT, sXprite, sZprite;
  8.  
  9.     var
  10.         ignoresp, zp: SpritePtr;
  11.         zWind: WindowPtr;
  12.         r: Rect;
  13.  
  14.     const
  15.         scrollSizeH = 200;
  16.         scrollSizeV = 150;
  17.  
  18.     function IsOptionPressed: Boolean;
  19.         var
  20.             km: KeyMap;
  21.     begin
  22.         GetKeys(km);
  23.         IsOptionPressed := km[58];
  24.     end;
  25.  
  26.     function Zyncho: Boolean;
  27.         var
  28.             where, dest: Rect;
  29.     begin
  30.         where.topLeft := zp^.position;
  31.         where.left := where.left - scrollSizeH div 2;
  32.         where.top := where.top - scrollSizeV div 2;
  33.         if where.left < 0 then
  34.             where.left := 0;
  35.         if where.top < 0 then
  36.             where.top := 0;
  37.         if where.left + scrollSizeH > gSAT.offSizeH then
  38.             where.left := gSAT.offSizeH - scrollSizeH;
  39.         if where.top + scrollSizeV > gSAT.offSizeV then
  40.             where.top := gSAT.offSizeV - scrollSizeV;
  41.         where.bottom := where.top + scrollSizeV;
  42.         where.right := where.left + scrollSizeH;
  43.         SetRect(dest, 0, 0, scrollSizeH, scrollSizeV);
  44.  
  45.         CopyBits(gSAT.offScreen.port^.portBits, gSAT.wind.port^.portBits, where, dest, srcCopy, nil);
  46.  
  47. {SATCopyBitsToScreen is obsolete - CopyBits is at least as fast for large areas anyway.}
  48. {For scrolling games, we must use other methods for improving the frame rate, like interlacing.}
  49.  
  50. {SATCopyBitsToScreen(gSAT.offScreen, where, dest, IsOptionPressed);}
  51. {Note that there's hardly any speed difference between fast and safe mode when copying areas this big!}
  52.  
  53.         Zyncho := true; {Tell SAT not to draw on-screen: we do that ourselves!}
  54.     end;
  55.  
  56.     procedure SetupZwind;
  57.         var
  58.             zr: Rect;
  59.             wrld: SysEnvRec;
  60.     begin
  61. {Since SAT hasn't been initialized yet, we can't use gSAT.colorFlag but have to check environs ourselves.}
  62.         if noErr <> SysEnvirons(1, wrld) then
  63.             ; {ignore errors}
  64.         SetRect(zr, 20, 30, 20 + scrollSizeH, 30 + scrollSizeV);
  65.         if wrld.hasColorQD then
  66.             Zwind := NewCWindow(nil, zr, '', false, plainDBox, WindowPtr(-1), false, 0)
  67.         else
  68.             Zwind := NewWindow(nil, zr, '', false, plainDBox, WindowPtr(-1), false, 0);
  69.     end;
  70.  
  71. begin
  72. {In case this isn't Think Pascal we have to make the standard inits ourselves.}
  73. {$IFC UNDEFINED THINK_PASCAL}
  74.     SATInitToolbox;
  75. {$ENDC}
  76.  
  77.     SetupZwind;
  78.  
  79.     SetRect(r, 0, 0, 510, 340);
  80.     SATCustomInit(128, 129, r, zwind, nil, false, false, false, true, false);
  81.     InitXprite;
  82.     InitZprite;
  83.     ShowWindow(gSAT.wind.port);
  84.     SelectWindow(gSAT.wind.port);
  85.     SATInstallSynch(@Zyncho);
  86.     zp := SATNewSprite(0, 90, 70, @SetupZprite);
  87.     ignoresp := SATNewSprite(0, 120, 100, @SetupXprite);
  88.     ignoresp := SATNewSprite(0, 200, 160, @SetupXprite);
  89.     SATSetPortScreen;
  90.     repeat
  91.         SATRun(IsOptionPressed);
  92.     until Button;
  93.  
  94. {WARNING! It seems like we mess up the current device somewhere. Probably a bug in SAT}
  95. {(where the device setting isn't perfect yet). Let's set port and device to something nice}
  96. {and safe!}
  97.     SetPort(gSAT.wind.port);
  98.     if gSAT.colorFlag then
  99.         SetGDevice(GetMainDevice);
  100. { Finally, make sure we dispose of the sound channel. }
  101.     SATSoundShutup;
  102. end.